home *** CD-ROM | disk | FTP | other *** search
/ SGI Freeware 1999 August / SGI Freeware 1999 August.iso / dist / fw_xemacs.idb / usr / freeware / lib / xemacs-20.4 / lisp / utils / redo.el.z / redo.el
Encoding:
Text File  |  1998-05-21  |  7.3 KB  |  190 lines
  1. ;;; redo.el -- Redo/undo system for XEmacs
  2.  
  3. ;; Copyright (C) 1985, 1986, 1987, 1993-1995 Free Software Foundation, Inc.
  4. ;; Copyright (C) 1995 Tinker Systems and INS Engineering Corp.
  5. ;; Copyright (C) 1997 Kyle E. Jones
  6.  
  7. ;; Author: Kyle E. Jones, February 1997
  8. ;; Keywords: lisp, extensions
  9.  
  10. ;; This file is part of XEmacs.
  11.  
  12. ;; XEmacs is free software; you can redistribute it and/or modify it
  13. ;; under the terms of the GNU General Public License as published by
  14. ;; the Free Software Foundation; either version 2, or (at your option)
  15. ;; any later version.
  16.  
  17. ;; XEmacs is distributed in the hope that it will be useful, but
  18. ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  19. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  20. ;; General Public License for more details.
  21.  
  22. ;; You should have received a copy of the GNU General Public License
  23. ;; along with XEmacs; see the file COPYING.  If not, write to the Free
  24. ;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
  25. ;; 02111-1307, USA.
  26.  
  27. ;;; Synched up with: Not in FSF.
  28.  
  29. ;;; Commentary:
  30.  
  31. ;; Derived partly from lisp/prim/simple.el in XEmacs.
  32.  
  33. ;; Emacs' normal undo system allows you to undo an arbitrary
  34. ;; number of buffer changes.  These undos are recorded as ordinary
  35. ;; buffer changes themselves.  So when you break the chain of
  36. ;; undos by issuing some other command, you can then undo all
  37. ;; the undos.  The chain of recorded buffer modifications
  38. ;; therefore grows without bound, truncated only at garbage
  39. ;; collection time.
  40. ;;
  41. ;; The redo/undo system is different in two ways:
  42. ;;   1. The undo/redo command chain is only broken by a buffer
  43. ;;      modification.  You can move around the buffer or switch
  44. ;;      buffers and still come back and do more undos or redos.
  45. ;;   2. The `redo' command rescinds the most recent undo without
  46. ;;      recording the change as a _new_ buffer change.  It
  47. ;;      completely reverses the effect of the undo, which
  48. ;;      includes making the chain of buffer modification records
  49. ;;      shorter by one, to counteract the effect of the undo
  50. ;;      command making the record list longer by one.
  51. ;;
  52. ;; Installation:
  53. ;;
  54. ;; Save this file as redo.el, byte compile it and put the
  55. ;; resulting redo.elc file in a directory that is listed in
  56. ;; load-path.
  57. ;;
  58. ;; In your .emacs file, add
  59. ;;   (require 'redo)
  60. ;; and the system will be enabled.
  61.  
  62. ;;; Code:
  63.  
  64. (provide 'redo)
  65.  
  66. (defvar redo-version "1.01"
  67.   "Version number for the Redo package.")
  68.  
  69. (defvar last-buffer-undo-list nil
  70.   "The head of buffer-undo-list at the last time an undo or redo was done.")
  71. (make-variable-buffer-local 'last-buffer-undo-list)
  72.  
  73. (make-variable-buffer-local 'pending-undo-list)
  74.  
  75. (defun redo (&optional count)
  76.   "Redo the the most recent undo.
  77. Prefix arg COUNT means redo the COUNT most recent undos.
  78. If you have modified the buffer since the last redo or undo,
  79. then you cannot redo any undos before then."
  80.   (interactive "*p")
  81.   (if (eq buffer-undo-list t)
  82.       (error "No undo information in this buffer"))
  83.   (if (eq last-buffer-undo-list nil)
  84.       (error "No undos to redo"))
  85.   (or (eq last-buffer-undo-list buffer-undo-list)
  86.       (and (null (car-safe buffer-undo-list))
  87.        (eq last-buffer-undo-list (cdr-safe buffer-undo-list)))
  88.       (error "Buffer modified since last undo/redo, cannot redo"))
  89.   (and (or (eq buffer-undo-list pending-undo-list)
  90.        (eq (cdr buffer-undo-list) pending-undo-list))
  91.        (error "No further undos to redo in this buffer"))
  92.   (or (eq (selected-window) (minibuffer-window))
  93.       (display-message 'progress "Redo..."))
  94.   (let ((modified (buffer-modified-p))
  95.     (recent-save (recent-auto-save-p))
  96.     (old-undo-list buffer-undo-list)
  97.     (p (cdr buffer-undo-list))
  98.     (records-between 0))
  99.     ;; count the number of undo records between the head of the
  100.     ;; undo chain and the pointer to the next change.  Note that
  101.     ;; by `record' we mean clumps of change records, not the
  102.     ;; boundary records.  The number of records will always be a
  103.     ;; multiple of 2, because an undo moves the pending pointer
  104.     ;; forward one record and prepend a record to the head of the
  105.     ;; chain.  Thus the separation always increases by two.  WHen
  106.     ;; we decrease it we will decrease it by a multiple of 2
  107.     ;; also.
  108.     (while p
  109.       (cond ((eq p pending-undo-list)
  110.          (setq p nil))
  111.         ((null (car p))
  112.          (setq records-between (1+ records-between))
  113.          (setq p (cdr p)))
  114.         (t
  115.          (setq p (cdr p)))))
  116.     ;; we're off by one if pending pointer is nil, because there
  117.     ;; was no boundary record in front of it to count.
  118.     (and (null pending-undo-list)
  119.      (setq records-between (1+ records-between)))
  120.     ;; don't allow the user to redo more undos than exist.
  121.     ;; only half the records between the list head and the pending
  122.     ;; pointer are undos that are a part of this command chain.
  123.     (setq count (min (/ records-between 2) count)
  124.       p (primitive-undo (1+ count) buffer-undo-list))
  125.     (if (eq p old-undo-list)
  126.     nil ;; nothing happened
  127.       ;; set buffer-undo-list to the new undo list.  if has been
  128.       ;; shortened by `count' records.
  129.       (setq buffer-undo-list p)
  130.       ;; primitive-undo returns a list without a leading undo
  131.       ;; boundary.  add one.
  132.       (undo-boundary)
  133.       ;; now move the pending pointer backward in the undo list
  134.       ;; to reflect the redo.  sure would be nice if this list
  135.       ;; were doubly linked, but no... so we have to run down the
  136.       ;; list from the head and stop at the right place.
  137.       (let ((n (- records-between count)))
  138.     (setq p (cdr old-undo-list))
  139.     (while (and p (> n 0))
  140.       (if (null (car p))
  141.           (setq n (1- n)))
  142.       (setq p (cdr p)))
  143.     (setq pending-undo-list p)))
  144.     (and modified (not (buffer-modified-p))
  145.      (delete-auto-save-file-if-necessary recent-save))
  146.     (or (eq (selected-window) (minibuffer-window))
  147.     (display-message 'progress "Redo!"))
  148.     (setq last-buffer-undo-list buffer-undo-list)))
  149.  
  150. (defun undo (&optional arg)
  151.   "Undo some previous changes.
  152. Repeat this command to undo more changes.
  153. A numeric argument serves as a repeat count."
  154.   (interactive "*p")
  155.   (let ((modified (buffer-modified-p))
  156.     (recent-save (recent-auto-save-p)))
  157.     (or (eq (selected-window) (minibuffer-window))
  158.     (display-message 'progress "Undo..."))
  159.     (or (eq last-buffer-undo-list buffer-undo-list)
  160.     (and (null (car-safe buffer-undo-list))
  161.          (eq last-buffer-undo-list (cdr-safe buffer-undo-list)))
  162.     (progn (undo-start)
  163.            (undo-more 1)))
  164.     (undo-more (or arg 1))
  165.     ;; Don't specify a position in the undo record for the undo command.
  166.     ;; Instead, undoing this should move point to where the change is.
  167.     ;;
  168.     ;;;; The old code for this was mad!  It deleted all set-point
  169.     ;;;; references to the position from the whole undo list,
  170.     ;;;; instead of just the cells from the beginning to the next
  171.     ;;;; undo boundary.  This does what I think the other code
  172.     ;;;; meant to do.
  173.     (let ((list buffer-undo-list)
  174.           (prev nil))
  175.       (while (and list (not (null (car list))))
  176.         (if (integerp (car list))
  177.             (if prev
  178.             (setcdr prev (cdr list))
  179.               ;; impossible now, but maybe not in the future 
  180.               (setq buffer-undo-list (cdr list))))
  181.         (setq prev list
  182.               list (cdr list))))
  183.     (and modified (not (buffer-modified-p))
  184.      (delete-auto-save-file-if-necessary recent-save)))
  185.   (or (eq (selected-window) (minibuffer-window))
  186.       (display-message 'progress "Undo!"))
  187.   (setq last-buffer-undo-list buffer-undo-list))
  188.  
  189. ;;; redo.el ends here
  190.